perm filename SCANNR.SAI[PNT,HE]11 blob
sn#543607 filedate 1980-11-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 IFCR NOT DECLARATION($$PRGID) THENC
C00003 00003 ! scanning routines
C00005 00004 ! pop,mty, push devstack
C00007 00005 ! expandmacro
C00011 00006 ! scanner: number,nums,GTOKEN,NAME_OF_FILE
C00021 00007 ! _read procedures
C00028 00008 ! input from different sources
C00032 ENDMK
C⊗;
IFCR NOT DECLARATION($$PRGID) THENC
ENTRY;
BEGIN "SCANNER" ENDC
DEFINE $SCANNER = TRUE ;
REQUIRE "HEADER.SAI" SOURCE_FILE;
FORWARD PROCEDURE NEWLINE;
! scanning routines;
SIMPLE STRING PROCEDURE SSCAN(REFERENCE STRING SOURCE; INTEGER BRK; REFERENCE INTEGER BRCHR);
BEGIN
STRING S1,SS;
INTEGER L;
S1←SOURCE;
SS←SCAN(SOURCE,BRK,BRCHR);
IF (L←LENGTH(S1)-LENGTH(SOURCE))>0 THEN
$CLNSAVE←$CLNSAVE&S1[1 TO L];
RETURN(SS);
END;
SIMPLE STRING PROCEDURE SINTSCAN(REFERENCE STRING SOURCE;REFERENCE INTEGER BRCHR);
BEGIN
STRING S1,SS;
INTEGER L,V;
S1←SOURCE;
V←INTSCAN(SOURCE,BRCHR);
IF (L←LENGTH(S1)-LENGTH(SOURCE))>0 THEN
SS←S1[1 TO L]
ELSE ERROR("SCANNER ERROR in SINTSCAN");
$CLNSAVE←$CLNSAVE&SS;
RETURN(SS);
END;
SIMPLE STRING PROCEDURE SREALSCAN(REFERENCE STRING SOURCE;REFERENCE INTEGER BRCHR);
BEGIN
STRING S1,SS;
INTEGER L;
REAL R;
S1←SOURCE;
R←REALSCAN(SOURCE,BRCHR);
IF (L←LENGTH(S1)-LENGTH(SOURCE))>0 THEN
SS←S1[1 TO L]
ELSE ERROR("SCANNER ERROR in SREALSCAN");
$CLNSAVE←$CLNSAVE&SS;
RETURN(SS);
END;
! pop,mty, push devstack;
RCLASS DEVSTACK(INTEGER DEV,DSKCHN; STRING $CLNE,$CLINR,$CRBODY;
RPTR(DEVSTACK)NEXT);
RPTR(DEVSTACK) DEVSTACKTOP;
STRING $CRBODY;
INTERNAL PROCEDURE POPDEVSTACK;
BEGIN
IF DEVSTACKTOP=NULL_RECORD THEN ERROR("cant pop device stack, already at bottom");
IF DEVICE=DSK_X THEN RELEASE($INPCH);
DEVICE←DEVSTACK:DEV[DEVSTACKTOP];
IF DEVICE=DSK_X THEN BEGIN $INPCH←DEVSTACK:DSKCHN[DEVSTACKTOP]; $EOF←FALSE; END;
$CLNE←DEVSTACK:$CLNE[DEVSTACKTOP];
$CLINR←DEVSTACK:$CLINR[DEVSTACKTOP];
$CRBODY←DEVSTACK:$CRBODY[DEVSTACKTOP];
DEVSTACKTOP←DEVSTACK:NEXT[DEVSTACKTOP];
END;
INTERNAL PROCEDURE MTYDEVSTACK;
BEGIN BOOLEAN FLAG; STRING S;
WHILE DEVSTACKTOP≠NULL_RECORD DO POPDEVSTACK;
DO S←INCHSL(FLAG) UNTIL FLAG=TRUE; ! CLEARS TYPEAHEAD ;
$CLNE←$CLINR←$CRBODY←NULL;
DEVICE←TTY_X;
END;
INTERNAL PROCEDURE PUSHDEVSTACK;
BEGIN
RPTR(DEVSTACK) D1;
D1←NEW_RECORD(DEVSTACK);
IF (DEVSTACK:DEV[D1]←DEVICE)=DSK_X THEN
BEGIN DEVSTACK:DSKCHN[D1]←$INPCH;
$INPCH← - 1; END;
DEVSTACK:$CLNE[D1]←$CLNE;
DEVSTACK:$CLINR[D1]←$CLINR;
DEVSTACK:$CRBODY[D1]←$CRBODY;
$CLNE←$CLINR←$CRBODY←NULL;
DEVSTACK:NEXT[D1]←DEVSTACKTOP;
DEVSTACKTOP←D1;
END;
! expandmacro;
INTEGER DUMMYDL;
PROCEDURE BTINIT;
SETBREAK(DUMMYDL←GETBREAK,DUMMY_DELIM,NULL,"IS");
REQUIRE BTINIT INITIALIZATION;
STRING PROCEDURE EXPANDPROC(RPTR(SYMBOL)S1);
BEGIN RPTR(MACRO) MOT;
STRING PARAM,CRBODY,CURBODY;
INTEGER BRCHAR,DLCOUNT,NPARAM;
STRING SAV$CLNSAV;
SAV$CLNSAV←$CLNSAVE[1 TO ∞ - LENGTH(TOKEN)];
NOEXPAND ← TRUE;
IF (NPARAM←MACRO:NPARAM[MOT←SYMBOL:OBJECT[S1]])≠ 0
THEN α "parametered macro"
STRING ARRAY ACTPRMS[1:NPARAM]; INTEGER I,J;
STRING DELIM;
GTOKEN; J←0;
IF TOKEN≠"(" THEN
IF MACRO:NON_DEFAULT_ARGS[MOT]=0 THEN
FOR I←1 STEP 1 UNTIL NPARAM DO
BEGIN STRING S;
S←MACRO:DEFAULT_ARG[MOT][I][2 TO ∞-1];
IF S="⊂" THEN S←S[2 TO ∞-1];
ACTPRMS[I]←S;
END
ELSE ERROR("Need at least one non-default argument")
ELSE
DO α "count parameters"
STRING TTOKEN;
GTOKEN; TTOKEN←NULL; J←J+1;
IF EQU(TOKEN,"⊂")
THEN α
DLCOUNT ← 1;
DO α
DELIM←READTILL("⊂⊃");
TTOKEN←TTOKEN&TOKEN&DELIM;
IF DELIM = "⊂"
THEN DLCOUNT ← DLCOUNT + 1
ELSE DLCOUNT ← DLCOUNT - 1;
β UNTIL DLCOUNT=0;
ACTPRMS[J]←TTOKEN[1 TO ∞-1];
GTOKEN;DELIM←TOKEN;
β
ELSE α
TTOKEN←TOKEN;
DELIM←READTILL(",)");
TTOKEN←TTOKEN&TOKEN;
ACTPRMS[J]←TTOKEN;
β;
β "count parameters"
UNTIL DELIM≠"," OR J=NPARAM;
IF DELIM≠")"
THEN ERROR("MACRO EXPANSION: need closed parenthesis here")
ELSE IF J<MACRO:NON_DEFAULT_ARGS[MOT]
THEN ERROR("MACRO EXPANSION: need "&
cvs(macro:non_default_args[mot])&" arguments here")
ELSE FOR I←J+1 STEP 1 UNTIL NPARAM DO
α STRING S;
S←MACRO:DEFAULT_ARG[MOT][I][2 TO ∞-1];
IF S="⊂" THEN S←S[2 TO ∞-1];
ACTPRMS[I]←S;
β;
CRBODY ← NULL;
CURBODY ← MACRO:BODY[MOT];
WHILE NOT EQU(CURBODY,NULL)
DO α INTEGER I;
CRBODY←CRBODY&SCAN(CURBODY,DUMMYDL,BRCHAR);
PARAM←SCAN(CURBODY,DUMMYDL,BRCHAR);
FOR I←1 STEP 1 UNTIL MACRO:NPARAM[MOT] DO
IF EQU(PARAM,MACRO:PRLIST[MOT][I]) THEN
α PARAM←ACTPRMS[I];DONE; β;
IF I>MACRO:NPARAM[MOT] AND BRCHAR≠0
THEN ERROR("EXPANDMACRO ERROR: ????");
CRBODY ← CRBODY & PARAM;
β;
β "parametered macro"
ELSE CRBODY ← MACRO:BODY[MOT];
NOEXPAND ← FALSE;
$CLNSAVE←SAV$CLNSAV;
RETURN(CRBODY);
END;
! scanner: number,nums,GTOKEN,NAME_OF_FILE ;
! checks if num is a number or @;
SIMPLE BOOLEAN PROCEDURE NUMBER(INTEGER NUM);
RETURN( "0"≤NUM≤"9" OR NUM="@");
! checks if the string word contains only numbers;
SIMPLE BOOLEAN PROCEDURE NUMS(STRING WORD);
BEGIN "NS"
STRING WW; INTEGER BR;
WW←SCAN(WORD,$NUMTAB,BR);
IF BR=0 THEN RETURN (TRUE) ELSE RETURN (FALSE);
END "NS";
! returns true if the last TOKEN is a terminal character, CR or ;
INTERNAL SIMPLE BOOLEAN PROCEDURE FINAL;
RETURN(TOKEN=SEMC OR TOKEN=CR OR TOKEN=NULL);
! ignores input up to and including the next occurence of CHAR;
INTERNAL SIMPLE PROCEDURE READTO(STRING CHAR);
BEGIN INTEGER I,BRCHAR; STRING R;
SETBREAK(I←GETBREAK, CHAR, NULL, "IA");
R←SSCAN($CLINR,I,BRCHAR);
WHILE BRCHAR≠CHAR DO BEGIN NEWLINE; R←SCAN($CLINR,I,BRCHAR); END;
RELBREAK(I);
END;
! returns in TOKEN the string upto but not including characters in CHARS:
The break character is retained in the input string;
INTERNAL SIMPLE INTEGER PROCEDURE READTILL(STRING CHARS);
BEGIN INTEGER I,BRCHAR; STRING R;
SETBREAK(I←GETBREAK, CHARS, NULL, "IS");
R←SSCAN($CLINR,I,BRCHAR);
WHILE BRCHAR=NULL DO BEGIN NEWLINE; R←R&CRLF&SSCAN($CLINR,I,BRCHAR); END;
RELBREAK(I); TOKEN←R;
RETURN(BRCHAR);
END;
INTERNAL PROCEDURE SAVETOKEN;
IF !DEBUG
THEN BEGIN STOKEN←FALSE;$CLINR←TOKEN&$CLINR;
$CLNSAVE←$CLNSAVE[1 TO ∞ - LENGTH(TOKEN)];END
ELSE STOKEN←TRUE;
RECURSIVE PROCEDURE R_TOKEN (BOOLEAN MUSTGETTOKEN(FALSE));
BEGIN "READ_TOKEN"
STRING WORD;INTEGER BRPARS; LABEL AGAIN;
! reads next RTOKEN using the indicated breaktable;
REQUIRE "<><>" DELIMITERS;
define rtoken(aaa)=<scan($CLINR, aaa ,brpars)>;
define rstoken(aaa)=<sscan($CLINR, aaa ,brpars)>;
URSCHD;
IF STOKEN THEN BEGIN STOKEN←FALSE;RETURN;END;
tokenlevel←tokenclass←tokenindex←0;
DEFINE NONSTOP=<(MUSTGETTOKEN OR (DEVICE≠TTY_X AND DEVICE≠QUERY_X))>;
AGAIN: WHILE NONSTOP AND $CLINR=NULL DO NEWLINE;
WORD←NULL; #TOKEN←UNDECLARED_TYPE;
RSTOKEN($SPCTAB); ! skips blanks;
WORD←RSTOKEN($RETAB); ! word is either identifier or integer;
IF WORD=NULL
THEN IF BRPARS="."
THEN BEGIN "period" ! no object read, period found;
RSTOKEN($SKTAB); ! appends the . to the string saved ;
RSTOKEN($ALFTAB); ! puts next character into brchr;
IF NUMBER(BRPARS)
THEN BEGIN "floating number"
$CLINR←"."&$CLINR;
$CLNSAVE←$CLNSAVE[1 TO ∞-1];
WORD←SREALSCAN($CLINR,BRPARS); ! reads until finds numbers;
#TOKEN ←REAL_TYPE; ! floating number read;
END "floating number"
ELSE BEGIN "operator"
WORD←".";
#TOKEN ←OPERATOR_TYPE; ! period is only a punctuation mark;
END "operator";
END "period"
ELSE IF (BRPARS=CR or BRPARS=NULL) AND NONSTOP
THEN BEGIN "newline"
NEWLINE;
GO TO AGAIN;
END "newline"
ELSE IF BRPARS="{"
THEN BEGIN "comment found"
! balance braces ;
INTEGER I,BRACE_COUNT;
BRACE_COUNT←0; ! brace is still on the input string ;
DO IF (I←READTILL("{}"))="{"
THEN BRACE_COUNT←BRACE_COUNT+1
ELSE BRACE_COUNT←BRACE_COUNT-1
UNTIL BRACE_COUNT=0;
GO TO AGAIN;
END "comment found"
ELSE IF BRPARS="⊗"
THEN BEGIN "⊗"
WORD←OLDOBJ;
RSTOKEN($SKTAB);
#TOKEN←ID_TYPE;
TOKENPTR←GRINCHSYM;
END "⊗"
ELSE BEGIN "operator"
WORD←BRPARS;
RSTOKEN($SKTAB);
#TOKEN ←OPERATOR_TYPE; ! punctuation mark found;
END "operator"
ELSE IF BRPARS="."
THEN IF NUMS(WORD)
THEN BEGIN "real number"
$CLINR←WORD&$CLINR;
$CLNSAVE←$CLNSAVE[1 TO ∞ - LENGTH(WORD)];
WORD←SREALSCAN($CLINR,BRPARS);
#TOKEN ←REAL_TYPE; ! floating number read;
END "real number";
TOKEN←WORD;
! checks if RTOKEN is an integer number;
IF TOKEN
THEN
IF #TOKEN =UNDECLARED_TYPE
THEN BEGIN
IF NUMBER(WORD)
THEN BEGIN ! if first ch. is a number;
$CLNSAVE←$CLNSAVE[1 TO ∞-LENGTH(WORD)];
$CLINR←WORD&$CLINR;
TOKEN←SINTSCAN($CLINR,BRPARS);
IF LENGTH(TOKEN)<LENGTH(WORD)
THEN ERROR("SCANNER ERROR: "&WORD&" is an invalid identifier and number");
#TOKEN←INT_TYPE;
END;
IF ¬NOEXPAND AND TOKENPTR←CHECK(TOKEN,#MC)
THEN BEGIN STRING SSS;
SSS←EXPANDPROC(TOKENPTR);
PUSHDEVSTACK;
$CRBODY←SSS;
DEVICE←MAC_X;
R_TOKEN;
END;
END;
END "READ_TOKEN";
INTERNAL RECURSIVE PROCEDURE GTOKEN (BOOLEAN MUSTGETTOKEN(TRUE));
BEGIN "GTOKEN"
R_TOKEN(MUSTGETTOKEN);
IF #TOKEN=UNDECLARED_TYPE
THEN IF DECSTR(TOKEN)≠0
THEN #TOKEN←RES_TYPE
ELSE begin "check for id"
RPTR(SYMBOL)S; RPTR(BLOCKREC)BR;
IF CURPROC THEN
IF EQU(TOKEN,SYMBOL:PNAME[CURPROC])
THEN BEGIN #TOKEN←ID_TYPE;TOKENPTR←CURPROC;
RETURN; END;
BR←CURBLOCK;
WHILE BR DO
BEGIN "check local variables"
S←SEARCHBLOCK(TOKEN,BR);
IF S THEN BEGIN #TOKEN←ID_TYPE;
TOKENPTR←S; TOKENLEVEL←BLOCKREC:LEVEL[BR];
TOKENINDEX←SYMBOL:TYPE[S]; RETURN; END;
BR←BLOCKREC:NEXT[BR];
END "check local variables";
IF #TOKEN=UNDECLARED_TYPE THEN
IF (TOKENPTR←CHECKTOT(TOKEN))≠NULL_RECORD
THEN BEGIN #TOKEN←ID_TYPE;
TOKENINDEX←SYMBOL:TYPE[TOKENPTR];
END;
end "check for id";
END "GTOKEN";
! reads a file name and returns it ;
INTERNAL STRING PROCEDURE NAME_OF_FILE;
BEGIN "FILENAME"
STRING NAME;
GTOKEN;
IF EQU(TOKEN,DQUOTE) THEN BEGIN READTILL(DQUOTE);RETURN(TOKEN);END;
NAME←TOKEN;GTOKEN(FALSE);
IF #TOKEN =REAL_TYPE
THEN IF TOKEN="."
THEN BEGIN NAME←NAME&TOKEN; GTOKEN(FALSE); END
ELSE ERROR("Identifier required")
ELSE IF EQU(TOKEN,".")
THEN BEGIN "EXT" ! extension;
GTOKEN; NAME←NAME&"."&TOKEN; GTOKEN(FALSE);
END "EXT";
IF TOKEN="["
THEN BEGIN "PPN" ! there is ppn;
GTOKEN; NAME←NAME&"["&TOKEN; GTOKEN(FALSE);
IF TOKEN=","
THEN BEGIN "PN"
GTOKEN(FALSE); ! there is the pn;
IF TOKEN=NULL THEN RETURN(NAME);
NAME←NAME&","&TOKEN;
GTOKEN(FALSE);
IF TOKEN="]" OR TOKEN=NULL THEN NAME←NAME&"]"
ELSE ERROR("] required");
END "PN"
ELSE IF TOKEN=NULL
THEN RETURN(NAME)
ELSE ERROR("comma required");
END "PPN"
ELSE SAVETOKEN;
RETURN(NAME);
END "FILENAME";
! _read procedures;
INTERNAL STRING PROCEDURE STR_READ;
BEGIN
! returns a string if a string is found;
WORD_READ(dquote);
READTILL(dquote);
RETURN(TOKEN);
END;
INTERNAL INTEGER PROCEDURE INTEGER_READ;
BEGIN
! reads a positive integer and returns it as a number;
INTEGER I;
R_TOKEN; IF #TOKEN≠INT_TYPE THEN ERROR("integer expected");
RETURN(INTSCAN(TOKEN,I));
END;
INTERNAL INTEGER PROCEDURE GE_ZERO_READ;
BEGIN
INTEGER TEMP;
IF (TEMP←INTEGER_READ)<0 THEN ERROR("non negative integer expected")
ELSE RETURN (TEMP);
END;
INTERNAL INTEGER PROCEDURE GT_ZERO_READ;
BEGIN
INTEGER TEMP;
IF (TEMP←INTEGER_READ)≤0 THEN ERROR("positive integer expected")
ELSE RETURN (TEMP);
END;
INTERNAL SIMPLE PROCEDURE SEMICOL_READ;
BEGIN
R_TOKEN(FALSE);
IF NOT FINAL THEN ERROR("Need ; or carriage return here");
END;
SIMPLE PROCEDURE WORD_READ0(STRING S,ERR(NULL));
BEGIN
R_TOKEN;
IF EQU(TOKEN,S) THEN RETURN;
IF ERR THEN ERROR(ERR&" requires "&S&" here")
ELSE ERROR("⊂"&S&"⊃ is required here");
END;
INTERNAL BOOLEAN PROCEDURE IS_TOKEN(STRING S);
BEGIN
! read the token S or a semicolon and return TRUE if token=S;
R_TOKEN(FALSE);
IF EQU(TOKEN,S) THEN RETURN(TRUE)
ELSE IF NOT FINAL THEN ERROR("; or carriage return")
ELSE RETURN(FALSE);
END;
INTERNAL SIMPLE PROCEDURE WORD_READ(STRING S);
WORD_READ0(S);
INTERNAL SIMPLE PROCEDURE WWORD_READ(STRING S1,S2);
BEGIN WORD_READ0(S1); WORD_READ0(S2); END;
INTERNAL SIMPLE PROCEDURE WORD2_READ(STRING S1,S2,ERR(NULL));
BEGIN
R_TOKEN;
IF EQU(TOKEN,S1) OR EQU(TOKEN,S2) THEN RETURN;
IF ERR THEN ERROR(ERR&" requires "&S1 & " or "& S2 &" here")
ELSE ERROR("⊂"&S1&"⊃ or ⊂"&S2&"⊃ is required here");
END;
INTERNAL SIMPLE STRING PROCEDURE IDF_READ;
BEGIN
R_TOKEN;
IF #TOKEN =INT_TYPE OR #TOKEN=REAL_TYPE OR #TOKEN=OPERATOR_TYPE
THEN ERROR("identifier required")
ELSE RETURN(TOKEN);
END;
INTERNAL SIMPLE STRING PROCEDURE MVFR_READ;
BEGIN
GTOKEN;
IF EQU(TOKEN,"BY")
THEN BEGIN SAVETOKEN; RETURN("BARM"); END
ELSE IF #TOKEN=ID_TYPE
THEN RETURN(TOKEN)
ELSE ERROR("identifier required");
END;
INTERNAL SIMPLE STRING PROCEDURE HAND_READ;
BEGIN ! reads BHAND or YHAND (default= BHAND);
R_TOKEN;
IF EQU(TOKEN,"BHAND") OR EQU(TOKEN,"YHAND")
THEN RETURN(TOKEN)
ELSE IF EQU(TOKEN,"TO") OR EQU(TOKEN,"BY")
THEN BEGIN SAVETOKEN; RETURN("BHAND"); END
ELSE ERROR("a hand required here");
END;
INTERNAL SIMPLE STRING PROCEDURE ARM_READ;
BEGIN ! reads "BARM" or "YARM" (default=BARM);
R_TOKEN(FALSE);
IF EQU(TOKEN,"YARM") OR EQU(TOKEN,"BARM")
THEN RETURN(TOKEN)
ELSE IF TOKEN=";" OR FINAL
THEN BEGIN SAVETOKEN; RETURN("BARM"); END
ELSE ERROR(" arm required here");
END;
INTERNAL RPTR(SYMBOL) PROCEDURE PROCNAME_READ;
BEGIN
GTOKEN;
IF #TOKEN=INT_TYPE
THEN BEGIN SAVETOKEN;RETURN(NULL_RECORD);END
ELSE BEGIN "PR"
SAVETOKEN;WORD_READ(DQUOTE);GTOKEN;
IF (#TOKEN=ID_TYPE AND SYMBOL:ACCESS[TOKENPTR]=#PROCEDURE)
THEN BEGIN WORD_READ(DQUOTE);RETURN(TOKENPTR);END
ELSE ERROR(DQUOTE&"PROCEDURE name"&DQUOTE&" expected");
END "PR";
END;
ifc false thenc
INTERNAL SIMPLE STRING PROCEDURE DEV_READ;
BEGIN ! reads BARM/YARM/POINTER (default=POINTER);
GTOKEN(FALSE);
IF EQU(TOKEN,"POINTER") OR EQU(TOKEN,"BARM") OR EQU(TOKEN,"YARM")
THEN RETURN(TOKEN)
ELSE IF FINAL OR TOKEN=";" THEN
BEGIN SAVETOKEN; RETURN("POINTER") END
ELSE ERROR(" arm or POINTER or ; required",CRLF);
END;
! returns the FROM frame "{FROM <frame>}" or STATION;
INTERNAL SIMPLE STRING PROCEDURE FROMPART;
BEGIN
STRING ROOT;
GTOKEN(FALSE);
IF EQU(TOKEN,"FROM")
THEN BEGIN ROOT←IDF_READ; RETURN(ROOT); END
ELSE IF FINAL
THEN RETURN("STATION")
ELSE ERROR("; or FROM required");
END;
endc
! input from different sources ;
INTERNAL PROCEDURE ASKUSER(STRING S(NULL));
BEGIN
PUSHDEVSTACK;
IF S=NULL
THEN BEGIN $CLNE←$CLINR←INCHWL; DEVICE←QUERY_X; END
ELSE BEGIN $CLNE←$CLINR←NULL; $CRBODY←S; DEVICE←PROGRAM_X; END;
END;
INTEGER $CVRTBREAK;
PROCEDURE INITCVRT;
SETBREAK($CVRTBREAK←GETBREAK,NULL,NULL,"K");
REQUIRE INITCVRT INITIALIZATION;
STRING PROCEDURE LISPMESS;
BEGIN
DEFINE MAIL = "710000000000";
STRING STR;INTEGER I;
INTEGER ARRAY MESS[1:32];
STR←NULL;
DO BEGIN
START_CODE
MAIL 1,ACCESS(MESS[1]);
END;
FOR I←1 STEP 1 UNTIL 31 DO STR←STR&CVASTR(MESS[I]);
END UNTIL MESS[32]=0;
RETURN(SCAN(STR,$CVRTBREAK,I));
END;
INTEGER TTYLINES;
PROCEDURE NEWLINE;
BEGIN
CHKESC_I;
$CLNSAVE←$CLNSAVE&CRLF;
CASE DEVICE OF
BEGIN
[QUERY_X] [MAC_X] [PROGRAM_X]
BEGIN
INTEGER BRCHAR;
IF $CRBODY THEN $CLNE←$CLINR←SCAN($CRBODY,$CRTAB,BRCHAR)
ELSE POPDEVSTACK;
END;
[TTY_X] BEGIN
INTEGER INCHSL_FLAG;
$CLNE←$CLINR←INCHSL(INCHSL_FLAG);
IF INCHSL_FLAG THEN
BEGIN ! no type ahead, better update;
IF NOT $UPDATED THEN RENEW;
IF STBEGIN THEN OUTSTR("* ") ELSE OUTSTR("***>>> ");
WHILE INCHSL_FLAG DO
BEGIN URSCHD; CALL(0,"SLEEP");
$CLNE←$CLINR←INCHSL(INCHSL_FLAG) END
END
ELSE IF STBEGIN THEN OUTSTR("* ")
ELSE OUTSTR("***>>> ");
IF $SYSOUT THEN CPRINT($SYSCH,$CLNE,CRLF);
IF $OUT THEN CPRINT($TTYCH,$CLNE,CRLF);
IF TTYLINES≥6 THEN
BEGIN IF $OUT THEN UDATEFILE($TTYCH);
IF $SYSOUT THEN UDATEFILE($SYSCH);
TTYLINES←0; END
ELSE TTYLINES←TTYLINES+1;
END;
[DSK_X] IF $EOF
THEN BEGIN $ALLOW←0; RELEASE($INPCH);
POPDEVSTACK; UPDATE;
END
ELSE BEGIN
$CLNE←$CLINR←INPUT($INPCH,$CRTAB);
IF NEWFILE THEN
BEGIN IF $CLNE[1 TO 17] =
"COMMENT ⊗ VALID"
THEN $CLNE←INPUT($INPCH,$FFTAB);
$CLNE←$CLINR←INPUT($INPCH,$CRTAB);
NEWFILE←FALSE;
END;
IF FILEPRINT THEN PRINT(CRLF,$CLNE);
END;
[MESSAGE_X]
BEGIN
OUTSTR("WAITING FOR MAIL... ");
$CLNE←$CLINR←LISPMESS;
OUTSTR("MAIL RECEIVED: "&$clne&crlf);
IF $OUT THEN BEGIN CPRINT($TTYCH,"{mail received}",$CLNE,CRLF);
IF TTYLINES≥6 THEN BEGIN UDATEFILE($TTYCH); TTYLINES←0; END
ELSE TTYLINES←TTYLINES+1;
END;
END;
ELSE BEGIN MTYDEVSTACK; ERROR("NO SUCH DEVICE"); END
END;
END;
END "SCANNER";